home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / perlMIF_beta2 / mif / mif_id.pl < prev    next >
Encoding:
Perl Script  |  1994-05-18  |  3.4 KB  |  91 lines
  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mif_id.pl
  4. ##  Author:
  5. ##      Earl Hood       ehood@convex.com
  6. ##  Description:
  7. ##    This file is defines the "mif_id" perl package.  It defines
  8. ##    routines to handle the MIFFile statement via MIFread_mif() defined in
  9. ##    the "mif" package.
  10. ##---------------------------------------------------------------------------##
  11. ##  Copyright (C) 1994  Earl Hood, ehood@convex.com
  12. ##
  13. ##  This program is free software; you can redistribute it and/or modify
  14. ##  it under the terms of the GNU General Public License as published by
  15. ##  the Free Software Foundation; either version 2 of the License, or
  16. ##  (at your option) any later version.
  17. ## 
  18. ##  This program is distributed in the hope that it will be useful,
  19. ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ##  GNU General Public License for more details.
  22. ##  
  23. ##  You should have received a copy of the GNU General Public License
  24. ##  along with this program; if not, write to the Free Software
  25. ##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26. ##---------------------------------------------------------------------------##
  27.  
  28. require 'mif/mif.pl' || die "Unable to require mif.pl\n";
  29.  
  30. package mif_id;
  31.  
  32. ##-------------------------------------------------##
  33. ## Add Units function to %MIFToken array ##
  34. ##-------------------------------------------------##
  35. $mif'MIFToken{'MIFFile'} = 'MIFFile';
  36.  
  37. ##----------------------------------------##
  38. ## Variable that stores the defaule units ##
  39. ##----------------------------------------##
  40. $rel = '4.00';
  41.  
  42. ##------------------------##
  43. ## Import 'mif' variables ##
  44. ##------------------------##
  45. $MStore        = $mif'MStore;
  46. $MOpen        = $mif'MOpen;
  47. $MClose        = $mif'MClose;
  48. $MLine        = $mif'MLine;
  49. $mso        = $mif'mso;
  50. $msc        = $mif'msc;
  51. $stb        = $mif'stb;
  52. $ste        = $mif'ste;
  53. $como        = $mif'como;
  54.  
  55.                 ##---------------##
  56.                 ## Main Routines ##
  57.                 ##---------------##
  58. ##---------------------------------------------------------------------------##
  59. ##      MIFwrite_mif_id() outputs the <MIFFile> statement to $handle.
  60. ##      $release is the release number (defaults to $rel), and
  61. ##      $comment is the end-of-line comment (defaults to "Generated
  62. ##      by mif.pl") without the begining '#' character.
  63. ##
  64. sub main'MIFwrite_mif_id {
  65.     local($handle, $release, $comment) = @_;
  66.  
  67.     $release = $rel unless $release;
  68.     $comment = "Generated by mif.pl" unless $comment;
  69.     $comment =~ s/\n/ /g;
  70.     print $handle $mso, 'MIFFile ', $release, $msc, " $como ", $comment, "\n";
  71. }
  72. ##---------------------------------------------------------------------------##
  73.                 ##--------------##
  74.                 ## Mif Routines ##
  75.                 ##--------------##
  76. ##---------------------------------------------------------------------------##
  77. ##    The routines definded below are all registered in the %MIFToken         ##
  78. ##    array for use in the read_mif() routine.  There purpose is to         ##
  79. ##    store the information contained in the MIFFile statement.         ##
  80. ##---------------------------------------------------------------------------##
  81.  
  82. ##---------------------------------------------------------------------------
  83. sub mif'MIFFile {
  84.     local($token, $mode, *data) = @_;
  85.     if ($data !~ /^\s*$/) {
  86.     ($rel) = $data =~ /^\s*(\S*)/o;
  87.     }
  88. }
  89. ##---------------------------------------------------------------------------
  90. 1;
  91.